(module bag mzscheme
  (provide (all-from "../bag.ss")
           make-bag
           bag?
           bag-empty?
           ; bag-fold
           bag-insert
           bag-insert-all
           bag-remove
           bag-remove-all
           bag-member?
           bag-get
           bag-union
           bag-intersection
           bag-difference
           bag-subbag?
           bag-equal?
           bag-size
           bag-size-distinct
           bag-occurrences   ; TODO: look up n dictinary, is this with a?
           bag-elements)

  (require (lib "etc.ss")
           (lib "unitsig.ss")
           (lib "list.ss")
           "../bag.ss"
           )
  
  ; A general bag consists of a "vector" of methods, a size and a specialized
  ; representation of the set.

  (define-struct <bag> 
    (methods   ;  methods
     bag     ; the specialized representation
     ))

  (define (bag? o) (<bag>? o))
  
  (define-struct bag-methods 
    ; IMPORTANT: When adding more methods, remember to add a keyword in 'call' below
    (empty? insert insert-all remove remove-all member? get fold 
            union intersection difference
            subbag? equal? size size-distinct occurrences elements))

  ; (call method-name methods . arguments) 
  ;   sugar coats the method calls
  (define-syntax call
    (syntax-rules (empty? insert insert-all remove remove-all member? get fold 
                          union intersection difference
                          subbag? equal? size size-distinct occurrences elements)
      ((call m empty?        s)     ((bag-methods-empty?                 m) s))
      ((call m insert        s x)   ((bag-methods-insert                 m) s x))
      ((call m insert-all    s xs)  ((bag-methods-insert-all             m) s xs))
      ((call m remove        s x)   ((bag-methods-remove                 m) s x))
      ((call m remove-all    s xs)  ((bag-methods-remove-all             m) s xs))
      ((call m member?       s x)   ((bag-methods-member?                m) s x))
      ((call m get           s)     ((bag-methods-get                    m) s))
      ((call m fold          s f i) ((bag-methods-fold                   m) s f i))
      ((call m union         s1 s2) ((bag-methods-union                  m) s1 s2))
      ((call m intersection  s1 s2) ((bag-methods-intersection           m) s1 s2))
      ((call m difference    s1 s2) ((bag-methods-difference             m) s1 s2))
      ((call m subbag?       s1 s2) ((bag-methods-subbag?                m) s1 s2))
      ((call m equal?        s1 s2) ((bag-methods-equal?                 m) s1 s2))
      ((call m size          s)     ((bag-methods-size                   m) s))
      ((call m size-distinct s)     ((bag-methods-union                  m) s))
      ((call m occurrences   s)     ((bag-methods-occurrences            m) s))
      ((call m elements      s)     ((bag-methods-elements               m) s))
      ((_ . more)                
       (error "call: unknown <bag> method / or method called with wrong number of arguments: " '(call . more)))))
    
  (define-syntax with-bag 
    (syntax-rules ()
      [(with-bag () body)              body]
      [(with-bag ((s m d)) body)       (let ((m (<bag>-methods s))
                                               (d (<bag>-bag s)))
                                           body)]
      [(with-bag ((s m d) . more) body)  (with-bag ((s m d))
                                                     (with-bag more
                                                                 body))]))


  (define make-bag
    (opt-lambda ([bag@ ordered-list-bag@]
                 [order@ eq-hash-order@])
      (use-bag (instantiate-bag bag@ order@))
      (make-<bag> (make-bag-methods empty? insert insert-all remove remove-all member? get fold 
                                    union intersection difference
                                    subbag? equal? size size-distinct occurrences elements)
                  empty)))
  
  (define make-bag/fn
    (opt-lambda (elm<
                 [bag@ ordered-list-bag@]
                 [elm= (lambda (a b) (and (not (elm< a b)) (not (elm< b a))))])
      (let ([_elm< elm<]
            [_elm= elm=]
            [_elm<= (lambda (a b) (or (elm< a b) (elm= a b)))])
      (make-bag 
       bag@ 
       (unit/sig ordered^
         (import)
         (define elm< _elm<)
         (define elm= _elm=)
         (define elm<= _elm<=))))))


  (define (bag-empty? b)           (with-bag ((b m d)) (call m fns-empty? d)))
  ;(define (bag-fold fn init b)    (invoke t fns-fold fn init (tt-data b)))
  (define (bag-insert b x)         (with-bag ((b m d)) (make-<bag> m (call m insert d x))))
  (define (bag-insert-all b xs)    (with-bag ((b m d)) (make-<bag> m (call m insert-all d xs))))
  (define (bag-remove b x)         (with-bag ((b m d)) (make-<bag> m (call m remove d x))))
  (define (bag-remove-all b xs)    (with-bag ((b m d)) (make-<bag> m (call m remove-all d xs))))
  (define (bag-member? b x)        (with-bag ((b m d)) (call m member? d x)))
  (define (bag-get b x)            (with-bag ((b m d)) (call m get d)))
  (define (bag-union b1 b2)        (with-bag ((b1 m1 d1) (b2 m2 d2)) (make-<bag> m1 (call m1 union d1 d2))))
  (define (bag-intersection b1 b2) (with-bag ((b1 m1 d1) (b2 m2 d2)) (make-<bag> m1 (call m1 intersection d1 d2))))
  (define (bag-difference b1 b2)   (with-bag ((b1 m1 d1) (b2 m2 d2)) (make-<bag> m1 (call m1 difference d1 d2))))
  (define (bag-subbag? b1 b2)      (with-bag ((b1 m1 d1) (b2 m2 d2)) (call m1 subbag? d1 d2)))
  (define (bag-equal? b1 b2)       (with-bag ((b1 m1 d1) (b2 m2 d2)) (call m1 equal? d1 d2)))
  (define (bag-size b)             (with-bag ((b m d)) (call m size d)))
  (define (bag-size-distinct b)    (with-bag ((b m d)) (call m size-distinct d)))
  (define (bag-occurrences b)      (with-bag ((b m d)) (call m occurences d)))
  (define (bag-elements b)         (with-bag ((b m d)) (call m elements d)))

  (define (tesb)
    (printf "~a~n"
            (bag-elements (bag-remove-all (bag-insert-all (make-bag/fn <) (list 1 2 3 4 5 3 3 2)) (list 2 3)))))

  (tesb)
  )

